PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/lo_pas.com/UNIT123.PAS

Pascal/Delphi Source File | 1989-05-27 | 17.2 KB | 510 lines

{$N+,E+}  (*  $N+ compiles for 80x87 which is used                 *)
          (*  automatically if available.  E+ activates the        *)
          (*  80X87 emulator which will be used if a coprocessor   *)
          (*  is not present.  I understand that these are program *)
          (*  wide options and cannot be used in a unit separately *)

(*  Written by Dan Glanz, Alexandria, Virginia (76672,2572), May, 1989. *)
(*  as a public service.                                                *)
(*  There are no restrictions on use and no gaurantees that it works.   *)

(*    All I ask is a smidgeon of credit.                          *)
(*  If you include this in a program, leave the credit line in. *)
(*  If you modify the unit, add your own credit line.           *)

(*    This is a Turbo Pascal 5.0 unit designed to allow reading and writing
    of Lotus 1-2-3,    Symphony, VP-Planner and other such files using the
    Lotus 1-2-3    file format.

    Lotus 1-2-3 uses 8 byte reals (TP's double's).  Any program using
    Lotus 1-2-3 data must either use a math coprocessor {$N+} or
    coprocessor emulation {$N+,E+}

    For demonstration purposes, a separate program called TEST123
    is included in the ARC file.

    It reads any Lotus format file and copies out label, integer and real
    cells and the current value of formula cells to a file in the same
    directory with the same name but with an extension of '.WK!'
    It does not copy formulas, range names, and other such information.
    It is purely designed to allow access to the DATA.

    Incidentally, you may be amazed at how fast a file loads when all
    of the blank cells, formulas, etc. have been removed by this
    program.

    Lotus_Version is set up as a typed constant as if the file were
    a Lotus version 1.0 or 1a type file.  Change it if you need to.
    The program automatically writes a version record at the beginning of
    the file when the file is opened for writing by calling
    Open_Lotus_Write_File.  It must do this or Lotus 1-2-3 will not
    allow use of the file.  The actual version read in from another file is
    ignored in this unit.  Obviously this can be changed.

    If you want to use the unit to create a Lotus formatted file directly,
    you must provide the row and column of the data in Lotus.Row and
    Lotus.Column, define the format in Lotus.Format (default seems to be 255)
    set the value in either Lotus.Integer_Value, Lotus.Real_Value, or
    Lotus.Label_Value.  Then set Lotus.Cell_Type := to Integer_Type,
    Real_Type, or Label_Type as the case may be    and call Write_Lotus_Record.

    Note: When you write your own labels in Label_Value, make sure you put
    a ' or " or ^ as the first character of the string.  Also, you may be
    able to include formulas in a worksheet you are creating by writing out
    a label cell containing with the formula and then deleting
    the ', ", or ^ in the spreadsheet itself, perhaps by using a macro.

    When you call Close_Lotus_Write_File, an end of file record is written
    and the file is automatically closed.

    Lotus 1-2-3 is a trademark of Lotus Corporation.

*)

Unit Unit123;
Interface

uses crt, dos;

Const
    Lotus_Version : integer = 1028;  {1028 for Lotus 1}
                                     {1029 for Symphony 1.0}
                                     {1030 for Lotus 2 & Symphony 1.1}

Type
    Lotus_Cell_Type = (Version_Type, End_Of_File_Type, Blank_Type,
                       Integer_Type, Real_Type, Label_Type,
                       Formula_Type, Unidentified_Type);

    Lotus_Record_Type =
        Record
            Cell_Type       : Lotus_Cell_Type;
            Cell_Type_Code    : Integer;
            Cell_Length        : Integer;
            Format            : Byte;
            Column            : integer;
            Row                : integer;
            Integer_Value    : integer;
            Real_Value        : double;
            Label_Value        : string;
            Formula_Length  : integer;
            Formula            : array [0 .. 255] of byte;
            Unidentified    : array [0 .. 511] of byte;
            Zero            : byte;     {used to terminate labels - ASCII-Z}
        end;
var
    Lotus_Read_File_Name    : string;
    Lotus_Read_File         : file;

    Lotus_Write_File_Name    : string;
    Lotus_Write_File        : file;

    Lotus_End_Of_File        : boolean;
    Lotus_Version_Name        : string;

    Lotus                    : Lotus_Record_Type;

Procedure Open_Lotus_Read_File;
Procedure Get_Version_Name;
Procedure Read_Type_and_Length;
Procedure Read_Format_Info;
Procedure Read_Lotus_Record;
Procedure Print_Lotus_Record;
Procedure Close_Lotus_Read_File;

Procedure Make_New_File_Name;
Procedure Open_Lotus_Write_File;
Procedure Write_Type_and_Length;
Procedure Write_Format_Info;
Procedure Write_Lotus_Record;
Procedure Close_Lotus_Write_File;

implementation

(****************************************************************)

Procedure Read_Type_and_Length;    {Could be changed to a single }
                                   {BlockRead since Cell_Type_Code}
                                   {Cell_Length are adjacent in the record}
                                   {definition and on the file.}
begin
    BlockRead(Lotus_Read_File, Lotus.Cell_Type_Code, 2);
    BlockRead(Lotus_Read_File, Lotus.Cell_Length,    2);

{   OPTIONAL}
{   BlockRead(Lotus_Read_File, Lotus.Cell_Type_Code, 4);   }

end;

(****************************************************************)

Procedure Write_Type_and_Length;        {Could be changed to a single }
                                        {BlockWrite since format, column}
                                        {and row are adjacent in the record}
                                        {definition and on the file.}
begin
    BlockWrite(Lotus_Write_File, Lotus.Cell_Type_Code, 2);
    BlockWrite(Lotus_Write_File, Lotus.Cell_Length,    2);

{   OPTIONAL}
{   BlockWrite(Lotus_Write_File, Lotus.Cell_Type_Code, 4);   }

end;

(****************************************************************)

Procedure Read_Format_Info;             {Could be changed to a single }
                                        {BlockRead since format, column}
                                        {and row are adjacent in the record}
                                        {definition and on the file.}
begin
    BlockRead(Lotus_Read_File, Lotus.Format, 1);
    BlockRead(Lotus_Read_File, Lotus.Column, 2);
    BlockRead(Lotus_Read_File, Lotus.Row,    2);

{   OPTIONAL}
{   BlockRead(Lotus_Read_File, Lotus.Format, 5);   }

end;

(****************************************************************)

Procedure Write_Format_Info;            {Could be changed to a single }
                                        {BlockWrite since format, column}
                                        {and row are adjacent in the record}
                                        {definition and on the file.}
begin
    BlockWrite(Lotus_Write_File, Lotus.Format, 1);
    BlockWrite(Lotus_Write_File, Lotus.Column, 2);
    BlockWrite(Lotus_Write_File, Lotus.Row,    2);

{   OPTIONAL}
{   BlockWrite(Lotus_Write_File, Lotus.Format, 5);   }

end;

(****************************************************************)

Procedure Open_Lotus_Read_File;
begin
{$I-}
    Assign(Lotus_Read_File,Lotus_Read_File_Name);
    Reset(Lotus_Read_File,1);
    If IoResult <> 0 then
        begin
            Writeln('Error opening file ', Lotus_Read_File_Name);
            halt;
        end;
{$I+}
     Read_Lotus_Record;                      {Read the first record}
                                             {If the first record is}
                                             {not a Version_Type record}
                                             {then this is not a Lotus File}

    If Lotus.Cell_Type <> Version_Type then
       begin
            Writeln('This is not a Lotus File');
            Halt
       end;

    Lotus_End_Of_File := false;
end;

(****************************************************************)

Procedure Open_Lotus_Write_File;
begin
{$I-}
    Assign(Lotus_Write_File,Lotus_Write_File_Name);
    ReWrite(Lotus_Write_File,1);
    If IoResult <> 0 then
        begin
            Writeln('Error opening file ', Lotus_Write_File_Name);
            halt;
        end;
{$I+}

{ Automatically write a version type record at the beginning of the file }
{ Lotus_Version is a typed constant set to Version 1.0 or 1A by default  }
{ If you have used Open_Lotus_File to read another Lotus file, then it   }
{ will have already read the version type record from the input file     }

    Lotus.Cell_Type_Code := 0;
    Lotus.Cell_Length    := 2;
    Write_Type_and_Length;
    BlockWrite(Lotus_Write_File,Lotus_Version,2);

end;

(****************************************************************)

Procedure Close_Lotus_Read_File;
begin
    Close(Lotus_Read_File);
end;

(****************************************************************)

Procedure Close_Lotus_Write_File;
begin
{ Write an end of file record at the end of the file }
    Lotus.Cell_Type_Code := 1;
    Lotus.Cell_Length    := 0;
    Write_Type_and_Length;            {End the file with a type 1 record}
    Close(Lotus_Write_File);
end;

(****************************************************************)

Procedure Get_Version_Name;
begin
    Case Lotus_Version of
        1028:
            Lotus_Version_Name := 'Lotus 1-2-3 Version 1.0 or 1A';
        1029:
            Lotus_Version_Name := 'Symphony Version 1.0';
        1030:
            Lotus_Version_Name := 'Lotus 1-2-3 Version 2.0, 2.1 or Symphony Version 1.1';
        Else
            Lotus_Version_Name := 'Unidentified';
    end;
end;

(****************************************************************)

Procedure Read_Lotus_Record;
begin
    FillChar(Lotus, SizeOf(Lotus), #0);
    Read_Type_and_Length;

    Case Lotus.Cell_Type_Code of

        0:  begin                             {Version Record}
                                              {There should be only one}
                                              {record of this type and it}
                                              {will normally be read when}
                                              {you call Open_Lotus_Read_File}

                Lotus.Cell_Type := Version_Type;
                BlockRead(Lotus_Read_File, Lotus_Version, 2);
                Get_Version_Name;
            end;

        1:  begin                                        {End of File}
                Lotus.Cell_Type := End_Of_File_Type;
                Lotus_End_of_File := True;
            end;

        12: begin                                        {Blank Record}
                Lotus.Cell_Type := Blank_Type;
                Read_Format_Info;
            end;

        13: begin                                         {Integer}
                Lotus.Cell_Type := Integer_Type;
                Read_Format_Info;
                BlockRead(Lotus_Read_File, Lotus.Integer_Value, 2);
            end;

        14: begin                                         {Real Value}
                Lotus.Cell_Type := Real_Type;
                Read_Format_Info;
                BlockRead(Lotus_Read_File, Lotus.Real_Value, 8);
            end;

        15: begin                                         {Label}
                Lotus.Cell_Type := Label_Type;
                Read_Format_Info;
                If Lotus.Cell_Length > 261 then
                    begin
                       Writeln('Big problem! Label at Row', Lotus.Row, ' Column ', Lotus.Column, ' has length > 255');
                       Halt;
                    end;
                BlockRead(Lotus_Read_File, Lotus.Formula, Lotus.Formula_Length);
                BlockRead(Lotus_Read_File, Lotus.Label_Value[1], Lotus.Cell_Length - 6);
                Lotus.Label_Value[0] := char(Lotus.Cell_Length - 6);
                BlockRead(Lotus_Read_File, Lotus.Zero, 1);
            end;

        16: begin                                         {Formula}
                Lotus.Cell_Type := Formula_Type;
                Read_Format_Info;
                BlockRead(Lotus_Read_File, Lotus.Real_Value, 8);
                BlockRead(Lotus_Read_File, Lotus.Formula_Length, 2);
                If Lotus.Formula_Length > 255 then
                    begin
                       Writeln('Big problem! Formula cell at Row', Lotus.Row, ' Column ', Lotus.Column, ' has length > 255');
                       Halt;
                    end;
                BlockRead(Lotus_Read_File, Lotus.Formula, Lotus.Formula_Length);
            end;

        Else                                              {Unidentified}
            begin
                Lotus.Cell_Type := Unidentified_Type;

            {    Use the following line only if you are sure that the length }
            {    of the unidentified data type is less than 512 characters.  }
            {    I the unidentified data cell is more than 512 byte long,    }
            {    it could cream the program by overwriting code.             }
            {    The check on cell length protects against this. But,        }
            {    if you don't know the maximum cell length, the safest       }
            {    approach is the approach I have taken, just skip the        }
            {    unknown data cell                                           }
            {                                                                }
            {    Read_Format_Info;                                           }
            {                                                                }
            {    If Lotus.Cell_Length > 512 then                             }
            {        begin                                                   }
            {           Writeln('Big problem! Cell at row ', Lotus.Row, ' Column ', Lotus.Coulmn, ' has  length > 512');   }
            {           Halt;                                                }
            {        end;                                                    }
            {                                                                }
            {    BlockRead (Lotus_Read_File, Lotus.Unidentified , Lotus.Cell_Length-5);}


            {    This is the safest way.}

                Seek(Lotus_Read_File, FilePos(Lotus_Read_File) + Lotus.Cell_Length);

            end;
        end;
end;

(****************************************************************)

Procedure Print_Lotus_Record;
begin
    If Lotus.Cell_Type = Blank_Type then exit;  {If you really want to}
                                                {show all of the blank}
                                                {records, delete this line}
    Writeln;
    Case Lotus.Cell_Type of

        Version_Type:
            Writeln(Lotus_Version_Name, ' Id Code = ',Lotus_Version);

        End_Of_File_Type:
            Writeln('End of File');

        Blank_Type:
            begin
                Write('Row = ',Lotus.Row,' Column = ', Lotus.Column, ' Format = ',Lotus.Format);
                Writeln(' Blank Cell');
            end;

        Integer_Type:
            begin
                Write('Row = ',Lotus.Row,' Column = ', Lotus.Column, ' Format = ',Lotus.Format);
                Writeln(' Integer = ', Lotus.Integer_Value);
            end;

        Real_Type:
            begin
                Write('Row = ',Lotus.Row,' Column = ', Lotus.Column, ' Format = ',Lotus.Format);
                Writeln(' Real = ', Lotus.Real_Value);
            end;

        Label_Type:
            begin
                Writeln('Row = ',Lotus.Row,' Column = ', Lotus.Column, ' Format = ',Lotus.Format);
                Writeln('Label = ', Lotus.Label_Value);
            end;

        Formula_Type:
            begin
                Write('Row = ',Lotus.Row,' Column = ', Lotus.Column, ' Format = ',Lotus.Format);
                Writeln(' Formula Value = ', Lotus.Real_Value);
            end;

        End_Of_File_Type:
            Writeln('End of file detected.');

        Unidentified_Type:
            begin
                Write('Row = ',Lotus.Row,' Column = ', Lotus.Column, ' Format = ',Lotus.Format);
                Writeln(' Unidentified Cell. OpCode = ', Lotus.Cell_Type_Code);
            end;

        Else
            begin
                Write('Row = ',Lotus.Row,' Column = ', Lotus.Column, ' Format = ',Lotus.Format);
                Writeln(' Unidentified Cell. OpCode = ', Lotus.Cell_Type_Code);
            end;
        end;

end;

(****************************************************************)

Procedure Write_Lotus_Record;

begin
    Case Lotus.Cell_Type of

        Blank_Type:
            Exit;

        Integer_Type:
            begin
                Lotus.Cell_Type_Code := 13;
                Lotus.Cell_Length := 7;
                Write_Type_and_Length;
                Write_Format_Info;
                BlockWrite(Lotus_Write_File,Lotus.Integer_Value,2);
            end;

        Real_Type:
            begin
                Lotus.Cell_Type_Code := 14;
                Lotus.Cell_Length := 13;
                Write_Type_and_Length;
                Write_Format_Info;
                BlockWrite(Lotus_Write_File,Lotus.Real_Value,8);
            end;

        Label_Type:
            begin
                Lotus.Cell_Type_Code := 15;
                Lotus.Cell_Length := 6 + Length(Lotus.Label_Value);
                Lotus.Zero := 0;
                Write_Type_and_Length;
                Write_Format_Info;
                BlockWrite(Lotus_Write_File,Lotus.Label_Value[1],Length(Lotus.Label_Value));
                BlockWrite(Lotus_Write_File,Lotus.Zero, 1);
            end;

        Formula_Type:    {NOTE: ONLY COPIES OUT THE CURRENT VALUE AS A REAL}
                         { If you want to copy the formula then also       }
                         { BlockWrite Lotus.Formula_Value.                 }
                         { See Read_Lotus_File for how to interpret length }
                         { Also, you must change the Cell_Type_Code to 16  }
            begin
                Lotus.Cell_Type_Code := 14;
                Lotus.Cell_Length := 13;
                Write_Type_and_Length;
                Write_Format_Info;
                BlockWrite(Lotus_Write_File,Lotus.Real_Value,8);
            end;

        Else
            begin
            end;
        end;

end;

(****************************************************************)

Procedure Make_New_File_Name;
var
    DirName        : DirStr;
    Fname        : NameStr;
    Fext        : ExtStr;
begin
    FSplit(Lotus_Read_File_Name, DirName, Fname, Fext);
    Lotus_Write_File_Name := DirName+Fname+'.WK!';
end;

begin
end.